BBS Toolkit/BBS Toolkit.iso/wildcat/wc30rec.zip/BTREEL.PAS

Pascal/Delphi Source File | 1992-05-12 | 7KB | 307 lines

var
  DebugLockFile  : PathStr;


  function IsLockOkayPrim(CheckLockError : Boolean) : Boolean;
  const
    MaxRetries = 50;

  const
    Retries : Byte = 0;
    CoversBuffer : Pointer = nil;
    CoverAllocated : Boolean = False;

  begin
    if not CheckLockError then
      begin
        IsLockOkayPrim := True;
        Retries := 0;
        if CoverAllocated then
          begin
            CoverAllocated := False;
            RestoreWindow(65, 1, 80, 1, True, CoversBuffer);
          end;
      end
    else if Retries < MaxRetries then
      begin
        IsLockOkayPrim := False;
        if CoverAllocated or SaveWindow(65, 1, 80, 1, True, CoversBuffer) then
          begin
            CoverAllocated := True;
            FastWrite('Lock retry #'+Long2Str(Retries), 1, 65, 31);
          end;
        Inc(Retries);
        Delay(500+Random(500));
      end
    else
      LogFatalError('Unable to lock file '+DebugLockFile, IsamError);
  end;


  function IsFilerOkay : Boolean;
  begin
    IsFilerOkay := IsLockOkayPrim(not IsamOk and (BTIsamErrorClass = 2));
  end;


  function IsDosOkay(FileResult : Word) : Boolean;
  begin
    IsDosOkay := IsLockOkayPrim(FileResult = 5);
  end;


  function PackUserName(UserName : Str25) : Str19;
  begin
    PackUserName := Pack6BitKeyUC(UserName, 19);
  end;


  function PackFileName(Name : Str12) : Str09;
  begin
    PackFileName := Pack6BitKeyUC(Name, 9);
  end;


  function GetDatabasePtr(Database : WcDatabases) : IsamFileBlockPtr;
  begin
    case Database of
      dbMsg  : GetDatabasePtr := MsgFile;
      dbUser : GetDatabasePtr := UserFile;
      dbFile : GetDatabasePtr := FileSpec;
    end;
  end;


  function LockBTree(Database : WcDatabases) : Boolean;
  var
    IFBPtr : IsamFileBlockPtr;

  begin
    if LockDatabase[Database] then
      begin
        LockBTree := False;
        Exit;
      end;
    case Database of
      dbMsg  : DebugLockFile := 'MSG';
      dbUser : DebugLockFile := 'USER';
      dbFile : DebugLockFile := 'FILE';
    end;
    IFBPtr := GetDatabasePtr(Database);
    repeat
      BtLockFileBlock(IFBPtr);
    until (IsFilerOkay);
    LockDatabase[Database] := True;
    LockBTree := True;
  end;


  procedure UnLockBtree(Database : WcDatabases);
  var
    IFBPtr : IsamFileBlockPtr;

  begin
    if not LockDatabase[Database] then
      Exit;
    IFBPtr := GetDatabasePtr(Database);
    repeat
      BtUnLockFileBlock(IFBPtr);
    until IsFilerOkay;
    LockDatabase[Database] := False;
  end;


  procedure InitializeBtree;
  var
    PageStackSize : LongInt;

  begin
    {$IFDEF Sversion}
    Cfig.Network := NoNet;
    Cfig.Nodeid := 1;
    {$ELSE}
    if MwFlagSet(mwAutoId) then
      if Cfig.NodeId = 0 then
        Cfig.NodeId := GetNextAutoNode
      else if IsAutoNode(Cfig.NodeId) then
        LogFatalError('Node #'+Long2Str(Cfig.NodeId)+' is an autonode id', 0);
    if Cfig.NodeId = 0 then
      LogFatalError('Error getting node id number', 9003);
    {$ENDIF}
    IsamWSNr := Cfig.NodeId;
    PageStackSize := BtInitIsam(Cfig.Network, MinimizeUseOfNormalHeap, 0);
    IsamWSNr := Cfig.NodeId;
    if not IsamOk then
      begin
        WriteLn('Insufficient memory for pagestack ', IsamError);
        Halt;
      end;
    if IsamWSNr > MaxNodes then
      begin
        WriteLn('Invalid node number. Node number out of range.');
        Halt;
      end;
    if not BTSetVariableRecBuffer(512) then
      begin
        WriteLn('Insufficient memory for record buffer ', IsamError, '.');
        Halt;
      end;
  end;


  function BtreeUsedRecs(IFBPtr : IsamFileBlockPtr) : LongInt;
  begin
    repeat
      BtreeUsedRecs := BtUsedRecs(IFBPtr);
    until IsFilerOkay;
  end;


  function BtreeUsedKeys(IFBPtr : IsamFileBlockPtr; KeyNr : Integer) : LongInt;
  begin
    repeat
      BtreeUsedKeys := BtUsedKeys(IFBPtr, KeyNr);
    until IsFilerOkay;
  end;


  procedure ClearBtreeKey(IFBPtr : IsamFileBlockPtr; KeyNr : Integer);
  begin
    repeat
      BtClearKey(IFBPtr, KeyNr);
    until IsFilerOkay;
  end;


  procedure NextBtreeKey(IFBPtr : IsamFileBlockPtr; var RefNr : LongInt; var Key : IsamKeyStr; KeyNr : Integer);
  begin
    repeat
      BtNextKey(IFBPtr, KeyNr, RefNr, Key);
    until IsFilerOkay;
  end;


  procedure NextDiffBtreeKey(IFBPtr : IsamFileBlockPtr; KeyNr : Byte; var RefNr : LongInt; var Key : IsamKeyStr);
  begin
    repeat
      BtNextDiffKey(IFBPtr, KeyNr, RefNr, Key);
    until IsFilerOkay;
  end;


  procedure PrevBtreeKey(IFBPtr : IsamFileBlockPtr; var RefNr : LongInt; var Key : IsamKeyStr; KeyNr : Integer);
  begin
    repeat
      BtPrevKey(IFBPtr, KeyNr, RefNr, Key);
    until IsFilerOkay;
  end;


  procedure PrevDiffBtreeKey(IFBPtr : IsamFileBlockPtr; KeyNr : Byte; var RefNr : LongInt; var Key : IsamKeyStr);
  begin
    repeat
      BtPrevDiffKey(IFBPtr, KeyNr, RefNr, Key);
    until IsFilerOkay;
  end;


  procedure FindBtreeKey(IFBPtr : IsamFileBlockPtr; var RefNr : LongInt; Key : IsamKeyStr; KeyNr : Integer);
  begin
    repeat
      BtFindKey(IFBPtr, KeyNr, RefNr, Key);
    until IsFilerOkay;
  end;


  procedure SearchBtreeKey(IFBPtr : IsamFileBlockPtr; var RefNr : LongInt; var Key : IsamKeyStr; KeyNr : Integer);
  begin
    repeat
      BtSearchKey(IFBPtr, KeyNr, RefNr, Key);
    until IsFilerOkay;
  end;


  function BtreeFreeRecs(IFBPtr : IsamFileBlockPtr) : LongInt;
  begin
    repeat
      BtreeFreeRecs := BtFreeRecs(IFBPtr);
    until IsFilerOkay;
  end;


  function BtreeFileLen(IFBPtr : IsamFileBlockPtr) : LongInt;
  begin
    repeat
      BtreeFileLen := BtFileLen(IFBPtr);
    until IsFilerOkay;
  end;


  procedure GetBtreeVarRec(IFBPtr : IsamFileBlockPtr; RefNr : LongInt; var Data);
  var
    RecSize : Word;

  begin
    repeat
      BtGetVariableRec(IFBPtr, RefNr, Data, RecSize);
    until IsFilerOkay;
  end;


  procedure GetBtreeVarRecPart(IFBPtr : IsamFileBlockPtr; RefNr : LongInt; Size : Word; var Data);
  begin
    repeat
      BtGetVariableRecPart(IFBPtr, RefNr, Data, Size);
    until IsFilerOkay;
  end;


  procedure GetBtreeRec(IFBPtr : IsamFileBlockPtr; RefNr : LongInt; var Data);
  begin
    repeat
      BtGetRec(IFBPtr, RefNr, Data, False);
    until IsFilerOkay;
  end;


  procedure OpenBtreeFile(var IFBPtr : IsamFileBlockPtr; FName : IsamFileBlockName);
  begin
    repeat
      BtOpenFileBlock(IFBPtr, FName, False, False, Cfig.DataBaseOpenMode = SaveMode, Cfig.Network <> NoNet);
    until IsFilerOkay;
  end;


  procedure CloseBtreeFilePrim(var IFBPtr : IsamFileBlockPtr);
  begin
    repeat
      BtCloseFileBlock(IFBPtr);
    until IsFilerOkay;
  end;


  procedure CloseBtreeFile(Database : WcDatabases);
  begin
    if not OpenDatabase[Database] then
      Exit;
    OpenDatabase[Database] := False;
    case Database of
      dbMsg  : CloseBtreeFilePrim(MsgFile);
      dbUser : CloseBtreeFilePrim(UserFile);
      dbFile : CloseBtreeFilePrim(FileSpec);
    end;
    if not IsamOk then
      LogFatalError('Error closing database', IsamError);
  end;


  procedure CloseAllFiles;
  var
    Database : WcDatabases;

  begin
    for Database := dbMsg to dbFile do
      CloseBtreeFile(Database);
  end;